perm filename BROWSE.NEW[TIM,LSP] blob sn#681180 filedate 1982-10-07 generic text, type T, neo UTF8
(FILECREATED " 7-OCT-82 15:58:40" ε∧{PHYLUM⎇<GABRIEL>BROWSE.;5ε↓ 5753   

      changes to:  (VARS BROWSECOMS)
		   (FNS RANDOMIZE)

      previous date: " 7-OCT-82 15:28:46" {PHYLUM⎇<GABRIEL>BROWSE.;3)


(* Copyright (c) 1982 by RPG)

(PRETTYCOMPRINT BROWSECOMS)

(RPAQQ εαBROWSECOMSε↓ ((FNS * BROWSEFNS)
		   (GLOBALVARS RAND)
		   (LOCALVARS . T)))

(RPAQQ εαBROWSEFNSε↓ (INVESTIGATE BROWSE MATCH RANDOMIZE RANDOM SEED INIT))
(DEFINEQ

(ε∧INVESTIGATEε↓
  (LAMBDA (UNITS PATS)                                       εβ(* JonL " 7-OCT-82 15:21")ε↓
    (PROG NIL
      LOOP(COND
	    ((NULL UNITS)
	      (RETURN NIL)))
          (PROG (P)
	        (SETQ P (GETPROP (CAR UNITS)
				 (QUOTE PATTERN)))
	    LOOP(COND
		  ((NULL P)
		    (RETURN NIL)))
	        (PROG (PTS)
		      (SETQ PTS PATS)
		  LOOP(COND
			((NULL PTS)
			  (RETURN NIL)))
		      (εαMATCHε↓ (CAR PTS)
			     (CAR P)
			     NIL)
		      (SETQ PTS (CDR PTS))
		      (GO LOOP))
	        (SETQ P (CDR P))
	        (GO LOOP))
          (SETQ UNITS (CDR UNITS))
          (GO LOOP))))

(ε∧BROWSEε↓
  (LAMBDA NIL
    (εαSEEDε↓)
    (εαINVESTIGATEε↓ (εαRANDOMIZEε↓ (εαINITε↓ 100 10 4
				  (QUOTE ((A A A B B B B A A A A A B B A A A)
					   (A A B B B B A A (A A)
					      (B B))
					   (A A A B (B A)
					      B A B A)))))
		 (QUOTE ((*A ?B *B ?B A *A A *B *A)
			  (*A *B *B *A (*A)
			      (*B))
			  (? ? *(B A)* ? ?))))))

(ε∧MATCHε↓
  (LAMBDA (PAT DAT ALIST)
    (COND
      ((NULL PAT)
	(NULL DAT))
      ((NULL DAT)
	NIL)
      ((OR (EQ (CAR PAT)
	       (QUOTE ?))
	   (EQ (CAR PAT)
	       (CAR DAT)))
	(εαMATCHε↓ (CDR PAT)
	       (CDR DAT)
	       ALIST))
      ((EQ (CAR PAT)
	   (QUOTE *))
	(OR (εαMATCHε↓ (CDR PAT)
		   DAT ALIST)
	    (εαMATCHε↓ (CDR PAT)
		   (CDR DAT)
		   ALIST)
	    (εαMATCHε↓ PAT (CDR DAT)
		   ALIST)))
      (T (COND
	   ((ATOM (CAR PAT))
	     (COND
	       ((EQ (NTHCHAR (CAR PAT)
			     1)
		    (QUOTE ?))
		 ((LAMBDA (VAL)
		     (COND
		       (VAL (εαMATCHε↓ (CONS (CDR VAL)
					 (CDR PAT))
				   DAT ALIST))
		       (T (εαMATCHε↓ (CDR PAT)
				 (CDR DAT)
				 (CONS (CONS (CAR PAT)
					     (CAR DAT))
				       ALIST)))))
		   (ASSOC (CAR PAT)
			  ALIST)))
	       ((EQ (NTHCHAR (CAR PAT)
			     1)
		    (QUOTE *))
		 ((LAMBDA (VAL)
		     (COND
		       (VAL (εαMATCHε↓ (APPEND (CDR VAL)
					   (CDR PAT))
				   DAT ALIST))
		       (T ((LAMBDA (G0024 G0025 G0026)
			      (PROG (L E D)
				    (PROGN (SETQ L G0024)
					   (SETQ E G0025)
					   (SETQ D G0026))
				LOOP(COND
				      ((NULL E)
					(RETURN NIL)))
				    (COND
				      ((εαMATCHε↓ (CDR PAT)
					      D
					      (CONS (CONS (CAR PAT)
							  L)
						    ALIST))
					(RETURN T)))
				    ((LAMBDA (G0024 G0025 G0026)
					(PROGN (SETQ L G0024)
					       (SETQ E G0025)
					       (SETQ D G0026)))
				      (NCONC L (CONS (CAR D)
						     NIL))
				      (CDR E)
				      (CDR D))
				    (GO LOOP)))
			    NIL
			    (CONS NIL DAT)
			    DAT))))
		   (ASSOC (CAR PAT)
			  ALIST)))))
	   (T (AND (NOT (ATOM (CAR DAT)))
		   (εαMATCHε↓ (CAR PAT)
			  (CAR DAT)
			  ALIST)
		   (εαMATCHε↓ (CDR PAT)
			  (CDR DAT)
			  ALIST))))))))

(ε∧RANDOMIZEε↓
  [LAMBDA (L)                                                εβ(* lmm " 7-OCT-82 15:43")ε↓
    (PROG (A)
          (SETQ A NIL)
      LOOP(COND
	    ((NULL L)
	      (RETURN A)))
          ([LAMBDA (N)
	      (COND
		((IEQP N 0)
		  (SETQ A (CONS (CAR L)
				A))
		  (SETQ L (CDR L)))
		(T ([LAMBDA (G0021 G0022)
		       (PROG (N X)
			     (PROGN (SETQ N G0021)
				    (SETQ X G0022))
			 LOOP[COND
			       ((IEQP N 1)
				 (RETURN (PROGN (SETQ A (CONS (CADR X)
							      A))
						(RPLACD X (CDDR X]
			     ([LAMBDA (G0021 G0022)
				 (PROGN (SETQ N G0021)
					(SETQ X G0022]
			       (IDIFFERENCE N 1)
			       (CDR X))
			     (GO LOOP]
		     N L]
	    (REMAINDER (εαRANDOMε↓)
		       (LENGTH L)))
          (GO LOOP])

(ε∧RANDOMε↓
  (LAMBDA NIL
    (RPAQ RAND (REMAINDER (ITIMES RAND 17)
			  251))))

(ε∧SEEDε↓
  (LAMBDA NIL
    (RPAQ RAND 21)))

(ε∧INITε↓
  (LAMBDA (N M NPATS IPATS)
    ((LAMBDA (IPATS)
	(PROG (P)
	      (SETQ P IPATS)
	  LOOP(COND
		((NULL (CDR P))
		  (RETURN (RPLACD P IPATS))))
	      (SETQ P (CDR P))
	      (GO LOOP))
	((LAMBDA (G0012 G0013 G0014 G0015)
	    (PROG (N I NAME A)
	          (PROGN (SETQ N G0012)
			 (SETQ I G0013)
			 (SETQ NAME G0014)
			 (SETQ A G0015))
	      LOOP(COND
		    ((IEQP N 0)
		      (RETURN A)))
	          (SETQ A (CONS NAME A))
	          (εαFORε↓ I εαFROMε↓ I εαTOε↓ 1 εαBYε↓ -1 εαDOε↓ (PUTPROP NAME (GENSYM)
						       NIL)
		     εαFINALLYε↓ (RETURN NIL))
	          (PUTPROP NAME (QUOTE PATTERN)
			   ((LAMBDA (G0016 G0017 G0018)
			       (PROG (I IPATS A)
				     (PROGN (SETQ I G0016)
					    (SETQ IPATS G0017)
					    (SETQ A G0018))
				 LOOP(COND
				       ((IEQP I 0)
					 (RETURN A)))
				     (SETQ A (CONS (CAR IPATS)
						   A))
				     ((LAMBDA (G0016 G0017)
					 (PROGN (SETQ I G0016)
						(SETQ IPATS G0017)))
				       (IDIFFERENCE I 1)
				       (CDR IPATS))
				     (GO LOOP)))
			     NPATS IPATS NIL))
	          (εαFORε↓ J εαFROMε↓ (IDIFFERENCE M I) εαTOε↓ 1 εαBYε↓ -1 εαDOε↓ (PUTPROP NAME (GENSYM)
								       NIL)
		     εαFINALLYε↓ (RETURN NIL))
	          ((LAMBDA (G0012 G0013 G0014)
		      (PROGN (SETQ N G0012)
			     (SETQ I G0013)
			     (SETQ NAME G0014)))
		    (IDIFFERENCE N 1)
		    (COND
		      ((IEQP I 0)
			M)
		      (T (IDIFFERENCE I 1)))
		    (GENSYM))
	          (GO LOOP)))
	  N M (GENSYM)
	  NIL))
      (SUBST NIL NIL IPATS))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS RAND)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE: DONTCOPY (PUTPROPS BROWSE COPYRIGHT ("RPG" 1982)))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (429 5553 (INVESTIGATE 439 . 1053) (BROWSE 1055 . 1400) (MATCH 1402 . 3155) (RANDOMIZE 
3157 . 3907) (RANDOM 3909 . 3990) (SEED 3992 . 4036) (INIT 4038 . 5551)))))
STOP